home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / gnu_tile_forth.lha / tst / locals.tst < prev    next >
Text File  |  1992-05-19  |  744b  |  57 lines
  1. .( Loading Locals test...) cr
  2.  
  3. locals
  4.  
  5.  
  6. .( 1: Redefinition of the basic stack operations using argument binding) cr
  7.  
  8. : swap { a b } b a ;
  9. : dup { a } a a ;
  10. : drop { a } ;
  11. : rot { a b c } b c a ;
  12.  
  13. 1 2 .s swap cr
  14. 3   .s dup cr
  15.     .s drop cr
  16.     .s rot cr
  17.     .s cr
  18. drop drop drop 
  19.  
  20.  
  21. .( 2: Recursive factorial function with argument binding) cr
  22.  
  23. : recursive { n }
  24.   n 0>
  25.   if n 1- recurse n *
  26.   else 1 then
  27. ;
  28.  
  29. 5 recursive . cr
  30.  
  31.  
  32. .( 3: Tail recursive factorial function) cr
  33.  
  34. : tail-recursive { n a }
  35.   n 0>
  36.   if n 1- n a * tail-recurse
  37.   else a then
  38. ;
  39.     
  40. 5 1 tail-recursive . cr
  41.  
  42.  
  43. .( 4: Iterative factorial function with a local variable) cr
  44.  
  45. : iterative { n | a }
  46.   1 -> a
  47.   n 1+ 1 do
  48.     i a * -> a
  49.   loop
  50.   a
  51. ;
  52.  
  53. 5 iterative . cr
  54.  
  55. forth only
  56.  
  57.